home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / vb / basecn.bas < prev    next >
Encoding:
BASIC Source File  |  1991-11-19  |  3.5 KB  |  104 lines
  1. ' This subroutine was originally uploaded by Lyle Jensen. I noticed right
  2. ' off that it could be more efficient and structured so I spent some time
  3. ' with it and here is the result. I have left the main routine the same.
  4. ' Only the sub has been to protect the innocent.
  5.  
  6. DECLARE FUNCTION BIBO$ (Number$, BaseIn AS INTEGER, BaseOut AS INTEGER)
  7.  
  8. ' Program to demonstrate the BIBO (base in, base out) function.
  9. ' This exercise arose out of a need I had to convert phone numbers
  10. ' (with area code) to an 8 character (or less) string so I could use
  11. ' them as DOS filenames (without using the 3 character extension---I needed
  12. ' that for something else).  Converting to hex wouldn't quite do it, so
  13. ' I tried base 20 and it worked.  I had the need to convert them back to
  14. ' valid phone numbers for transmission, hence the other function.
  15. ' I started with BASECV.BAS downloaded from CIS IBMSYS lib #7.  Frankly,
  16. ' I really haven't had time to tear the algorithms apart to see exactly
  17. ' how they work, so I cannot address that!  The original author (the name
  18. ' was not in the file, so I cannot credit them), stated that they had
  19. ' help from the National Bureau of Standards Handbook of Mathematical
  20. ' Functions.
  21. ' Comments are welcome (especially how to increase speed), use at your
  22. ' own risk, etc.  I have not tested the results with the NBS or any such
  23. ' authority, nor have I even tested the outer limits of the algorithms---
  24. ' which are considerable since I've used double precision.  I do know
  25. ' that it will convert any phone number I've thrown at it to an 8 character
  26. ' string and back again, so it suits my needs.
  27. ' Lyle Jensen CIS 76666,1401.
  28.  
  29. DEFINT A-Z
  30.  
  31. PRINT
  32. Seed$ = "18005551212"
  33. PRINT "Seed: "; Seed$
  34. Base20$ = BIBO$(Seed$, 10, 20)
  35. PRINT "Base 10 to 20: "; Base20$
  36. Base10$ = BIBO$(Base20$, 20, 10)
  37. PRINT "Back to base 10: "; Base10$
  38. Seed$ = "FFFF"
  39. PRINT "New seed: "; Seed$
  40. Base10$ = BIBO$(Seed$, 16, 10)
  41. PRINT "Base 16 to 10: "; Base10$
  42. Base16$ = BIBO$(Base10$, 10, 16)
  43. PRINT "Back to base 16: "; Base16$
  44.  
  45. END
  46.  
  47. FUNCTION BIBO$ (Number$, BaseIn AS INTEGER, BaseOut AS INTEGER)
  48.    
  49.     CONST Digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  50.     Decimal# = 0
  51.     
  52.     ' First we convert from BaseIn to base 10
  53.     SELECT CASE BaseIn
  54.         CASE 10
  55.              Decimal# = VAL(Number$)
  56.        
  57.         ' BaseIn is too high
  58.         CASE IS > LEN(Digits)
  59.              EXIT FUNCTION
  60.     
  61.         CASE ELSE
  62.              ' Convert to base 10.
  63.             NumberLength = LEN(Number$)
  64.             Decimal# = 0
  65.    
  66.             FOR I = 1 TO NumberLength
  67.                 J = INSTR(Digits, MID$(Number$, I, 1))
  68.                 '  Cannot continue if BaseIn is illegal
  69.                 IF J = 0 THEN EXIT FUNCTION
  70.                 Decimal# = Decimal# + INT((J - 1) * (BaseIn ^ (NumberLength - I)) + .5)
  71.             NEXT I
  72.    
  73.     END SELECT
  74.  
  75.     ' Second we convert from base 10 to BaseOut
  76.     SELECT CASE BaseOut
  77.        
  78.         CASE 8
  79.             BIBO$ = OCT$(Decimal#)
  80.  
  81.         CASE 10
  82.             BIBO$ = STR$(Decimal#)
  83.        
  84.         CASE 16
  85.             BIBO$ = HEX$(Decimal#)
  86.        
  87.         ' BaseOut is too high
  88.         CASE IS > LEN(Digits)
  89.             EXIT FUNCTION
  90.  
  91.         CASE ELSE
  92.             DO
  93.                  Y# = Decimal# / BaseOut
  94.                  X = INT((Y# - INT(Y#)) * BaseOut + 1.5)
  95.                  NumberOut$ = MID$(Digits, X, 1) + NumberOut$
  96.                  Decimal# = INT(Y#)
  97.             LOOP WHILE Decimal# > 0
  98.             BIBO$ = NumberOut$
  99.    
  100.     END SELECT
  101.  
  102. END FUNCTION
  103.  
  104.